home *** CD-ROM | disk | FTP | other *** search
/ Shareware Super Platinum 8 / Shareware Super Platinum 8.iso / mac / DATABASE / OBTN52.ZIP;1 / TESTBTN.PRG < prev   
Encoding:
Text File  |  1993-06-01  |  4.6 KB  |  158 lines
  1. // ----------------------------------------------------------------------------
  2. // Demo for TButton() class for CLIPPER 5
  3. // Created by Juan Miguel Sosso using captured BORLAND C++ 3.1 screens
  4. // Thanks to Borland's team for their powerfull compiler
  5. // and the star of the show is... TButton Class without external OOPS libraries!
  6. //
  7. // Note: This demo only works ok in 80x25 screen mode
  8.  
  9.  
  10. #include "Button.ch"
  11. #include "InKey.ch"
  12. #include "box.ch"
  13.  
  14. // ----------------------------------------------------------------------------
  15.  
  16. Function Main()
  17.  
  18.   local cOldColor := SetColor( "W+/B, W+/G,,, BG+/B" )
  19.   local cBc       := MemoRead( "BC.BIN" )
  20.  
  21.   SET SCOREBOARD OFF
  22.  
  23.   SetPos( 2, 1 )
  24.   RestScreen( 0, 0, 24, 79, cBc )
  25.   Inkey( 2 )
  26.   RestScreen( 0, 0, 24, 79, MemoRead( "BCDIR.BIN" ) )
  27.   RunBcDir()
  28.   SetPos( 2, 1 )
  29.   RestScreen( 0, 0, 24, 79, cBc )
  30.   Inkey( 2 )
  31.   RestScreen( 0, 0, 24, 79, MemoRead( "BCAPP.BIN" ) )
  32.   RunBcApp()
  33.   SetPos( 2, 1 )
  34.   RestScreen( 0, 0, 24, 79, cBc )
  35.   Inkey( 2 )
  36.  
  37.   SetColor( cOldColor )
  38.   ClearScr()
  39.   ? "That's all folks..."
  40.   ?
  41.  
  42. Return NIL
  43.  
  44. // ----------------------------------------------------------------------------
  45.  
  46. Function RunBcDir()
  47.  
  48.   local cInclude := "C:\LENG\BORLANDC\INCLUDE                           "
  49.   local cLib     := "C:\LENG\BORLANDC\LIB                               "
  50.   local cOutput  := "C:\PROYECTO\BUTTON                                 "
  51.   local cSource  := "C:\PROYECTO\BUTTON                                 "
  52.  
  53.   @  7, 15 GET cInclude
  54.   @ 10, 15 GET cLib
  55.   @ 13, 15 GET cOutput
  56.   @ 16, 15 GET cSource
  57.  
  58.   @ 18, 34 BUTTON "   O&K   " ACTION __KeyBoard( Chr( K_CTRL_W ) ) COLOR "BG+/G, GR+/G"
  59.   @ 18, 46 BUTTON " &Cancel " ACTION __KeyBoard( Chr( K_ESC ) ) COLOR "N/G, GR+/G"
  60.   @ 18, 58 BUTTON "  &Help  " ACTION Alert( "Help Text" ) COLOR "N/G, GR+/G"
  61.  
  62.   READ
  63.  
  64.   if LastKey() != K_ESC
  65.     Alert( "Ok, let's store the info" )
  66.     // ...
  67.   endif
  68.  
  69. Return NIL
  70.  
  71. // ----------------------------------------------------------------------------
  72.  
  73. Function RunBcApp()
  74.  
  75.   DispText( 1 )
  76.  
  77.   @ 13,  7 BUTTON " DOS &Standard " COLOR "N/G, GR+/G" ACTION DispText( 1 )
  78.   @ 13, 25 BUTTON " DOS &Overlay " COLOR "N/G, GR+/G" ACTION DispText( 2 )
  79.   @ 13, 42 BUTTON " Windows &App " COLOR "N/G, GR+/G" ACTION DispText( 3 )
  80.   @ 13, 59 BUTTON " Windows &DLL " COLOR "N/G, GR+/G" ACTION DispText( 4 )
  81.  
  82.   @ 17, 40 BUTTON "   O&K   " ACTION __KeyBoard( Chr( K_CTRL_W ) ) COLOR "BG+/G, GR+/G"
  83.   @ 17, 52 BUTTON " &Cancel " ACTION __KeyBoard( Chr( K_ESC ) ) COLOR "N/G, GR+/G"
  84.   @ 17, 64 BUTTON "  &Help  " ACTION Alert( "Help Text" ) COLOR "N/G, GR+/G"
  85.  
  86.   READ
  87.  
  88.   if LastKey() != K_ESC
  89.     Alert( "Ok, let's store the info" )
  90.     // ...
  91.   endif
  92.  
  93. Return NIL
  94.  
  95. // ----------------------------------------------------------------------------
  96.  
  97. Function DispText( nText )
  98.  
  99.   local cText[ 4 ]
  100.   local n
  101.  
  102.   do case
  103.     case nText == 1
  104.       cText[ 1 ] = "TButton class for CLIPPER    (c) 1.993 RUNsoft"
  105.       cText[ 2 ] = "Written by Antonio Linares & Juan Miguel Sosso"
  106.       cText[ 3 ] = "This is not a demo, it is full operational"
  107.       cText[ 4 ] = "ShareWare edition, please support it"
  108.     case nText == 2
  109.       cText[ 1 ] = "You have a 21 days to evaluate this product and decide to"
  110.       cText[ 2 ] = "purchase it or stop using it"
  111.       cText[ 3 ] = "If you decide to register you will receive ALL THE SOURCE CODE"
  112.       cText[ 4 ] = "and post mail or electronic mail support"
  113.     case nText == 3
  114.       cText[ 1 ] = "To register send $30 (plus $3 if outside of Spain) to:"
  115.       cText[ 2 ] = "RUNsoft"
  116.       cText[ 3 ] = "M†laga 40, 3ß"
  117.       cText[ 4 ] = "29600 Marbella (MA) Spain"
  118.     case nText == 4
  119.       cText[ 1 ] = "If you want to contact with the autors send us a letter to RUNsoft,"
  120.       cText[ 2 ] = "write a message to adress 2:345/201.8@fidoned.org or call"
  121.       cText[ 3 ] = "our BBS system at +34-5-221-3374 (24h) up to 19.200 bps"
  122.       cText[ 4 ] = "Leave a message in RUNsoft area and look for new products"
  123.   endcase
  124.  
  125.   for n = 1 to 4
  126.     @ 5 + n, 6 SAY PadC( cText[ n ], 68 ) COLOR "BG+/B"
  127.   next
  128.  
  129. Return NIL
  130.  
  131. // ----------------------------------------------------------------------------
  132.  
  133. Function ClearScr()
  134.  
  135.   local n, nLin, nCol
  136.  
  137.   for n = 0 to MaxCol()
  138.     nLin = 0
  139.     nCol = n
  140.     while nLin <= MaxRow() .and. nCol >= 0
  141.       @ nLin++, nCol-- SAY " "
  142.     enddo
  143.   next
  144.  
  145.   for n = 0 to MaxRow()
  146.     nLin = n
  147.     nCol = MaxCol()
  148.     while nLin <= MaxRow()
  149.       @ nLin++, nCol-- SAY " "
  150.     enddo
  151.   next
  152.  
  153.   SetPos( 0, 0 )
  154.  
  155. Return NIL
  156.  
  157. // ----------------------------------------------------------------------------
  158.